home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / total / formmail / FormMail.pl next >
Encoding:
Perl Script  |  1996-02-05  |  13.0 KB  |  437 lines
  1. #!/usr/bin/perl
  2. ##############################################################################
  3. # FormMail            Version 1.5                     #
  4. # Copyright 1996 Matt Wright    mattw@misha.net                     #
  5. # Created 6/9/95                Last Modified 2/5/96                 #
  6. # Scripts Archive at:        http://www.worldwidemart.com/scripts/         #
  7. ##############################################################################
  8. # COPYRIGHT NOTICE                                                           #
  9. # Copyright 1996 Matthew M. Wright  All Rights Reserved.                     #
  10. #                                                                            #
  11. # FormMail may be used and modified free of charge by anyone so long as this #
  12. # copyright notice and the comments above remain intact.  By using this      #
  13. # code you agree to indemnify Matthew M. Wright from any liability that      #  
  14. # might arise from it's use.                                                 #  
  15. #                                         #
  16. # Selling the code for this program without prior written consent is         #
  17. # expressly forbidden.  In other words, please ask first before you try and  #
  18. # make money off of my program.                             #
  19. ##############################################################################
  20. # Define Variables 
  21. #     Detailed Information Found In README File.
  22.  
  23. # $mailprog defines the location of your sendmail program on your unix 
  24. # system.
  25.  
  26. $mailprog = '/usr/lib/sendmail';
  27.  
  28. # @referers allows forms to be located only on servers which are defined 
  29. # in this field.  This fixes a security hole in the last version which 
  30. # allowed anyone on any server to use your FormMail script.
  31.  
  32. @referers = ('www.worldwidemart.com','worldwidemart.com','206.31.72.203');
  33.  
  34. # Done
  35. #############################################################################
  36.  
  37. # Check Referring URL
  38. &check_url;
  39.  
  40. # Retrieve Date
  41. &get_date;
  42.  
  43. # Parse Form Contents
  44. &parse_form;
  45.  
  46. # Check Required Fields
  47. &check_required;
  48.  
  49. # Return HTML Page or Redirect User
  50. &return_html;
  51.  
  52. # Send E-Mail
  53. &send_mail;
  54.  
  55. sub check_url {
  56.  
  57.    if ($ENV{'HTTP_REFERER'}) {
  58.       foreach $referer (@referers) {
  59.          if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
  60.             $check_referer = '1';
  61.         last;
  62.          }
  63.       }
  64.    }
  65.    else {
  66.       $check_referer = '1';
  67.    }
  68.  
  69.    if ($check_referer != 1) {
  70.       &error('bad_referer');
  71.    }
  72.  
  73. }
  74.  
  75. sub get_date {
  76.  
  77.    @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  78.    @months = ('January','February','March','April','May','June','July',
  79.           'August','September','October','November','December');
  80.  
  81.    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  82.    if ($hour < 10) { $hour = "0$hour"; }
  83.    if ($min < 10) { $min = "0$min"; }
  84.    if ($sec < 10) { $sec = "0$sec"; }
  85.  
  86.    $date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";
  87.  
  88. }
  89.  
  90. sub parse_form {
  91.  
  92.    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
  93.       # Split the name-value pairs
  94.       @pairs = split(/&/, $ENV{'QUERY_STRING'});
  95.    }
  96.    elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
  97.       # Get the input
  98.       read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
  99.  
  100.       # Split the name-value pairs
  101.       @pairs = split(/&/, $buffer);
  102.    }
  103.    else {
  104.       &error('request_method');
  105.    }
  106.  
  107.    foreach $pair (@pairs) {
  108.       ($name, $value) = split(/=/, $pair);
  109.  
  110.       $name =~ tr/+/ /;
  111.       $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  112.  
  113.       $value =~ tr/+/ /;
  114.       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  115.  
  116.       # If they try to include server side includes, erase them, so they
  117.       # arent a security risk if the html gets returned.  Another 
  118.       # security hole plugged up.
  119.  
  120.       $value =~ s/<!--(.|\n)*-->//g;
  121.  
  122.       # Create two associative arrays here.  One is a configuration array
  123.       # which includes all fields that this form recognizes.  The other
  124.       # is for fields which the form does not recognize and will report 
  125.       # back to the user in the html return page and the e-mail message.
  126.       # Also determine required fields.
  127.  
  128.       if ($name eq 'recipient' ||
  129.       $name eq 'subject' ||
  130.       $name eq 'email' ||
  131.       $name eq 'realname' ||
  132.       $name eq 'redirect' ||
  133.       $name eq 'bgcolor' ||
  134.       $name eq 'background' ||
  135.       $name eq 'link_color' ||
  136.       $name eq 'vlink_color' ||
  137.           $name eq 'text_color' ||
  138.          $name eq 'alink_color' ||
  139.       $name eq 'title' ||
  140.       $name eq 'sort' ||
  141.       $name eq 'print_config' ||
  142.       $name eq 'return_link_title' ||
  143.       $name eq 'return_link_url' && ($value)) {
  144.          
  145.      $CONFIG{$name} = $value;
  146.       }
  147.       elsif ($name eq 'required') {
  148.          @required = split(/,/,$value);
  149.       }
  150.       elsif ($name eq 'env_report') {
  151.          @env_report = split(/,/,$value);
  152.       }
  153.       else {
  154.          if ($FORM{$name} && ($value)) {
  155.         $FORM{$name} = "$FORM{$name}, $value";
  156.      }
  157.          elsif ($value) {
  158.             $FORM{$name} = $value;
  159.          }
  160.       }
  161.    }
  162. }
  163.  
  164. sub check_required {
  165.  
  166.    foreach $require (@required) {
  167.       if ($require eq 'recipient' ||
  168.           $require eq 'subject' ||
  169.           $require eq 'email' ||
  170.           $require eq 'realname' ||
  171.           $require eq 'redirect' ||
  172.           $require eq 'bgcolor' ||
  173.           $require eq 'background' ||
  174.           $require eq 'link_color' ||
  175.           $require eq 'vlink_color' ||
  176.           $require eq 'alink_color' ||
  177.           $require eq 'text_color' ||
  178.       $require eq 'sort' ||
  179.           $require eq 'title' ||
  180.           $require eq 'print_config' ||
  181.           $require eq 'return_link_title' ||
  182.           $require eq 'return_link_url') {
  183.  
  184.          if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') {
  185.             push(@ERROR,$require);
  186.          }
  187.       }
  188.       elsif (!($FORM{$require}) || $FORM{$require} eq ' ') {
  189.          push(@ERROR,$require);
  190.       }
  191.    }
  192.  
  193.    if (@ERROR) {
  194.       &error('missing_fields', @ERROR);
  195.    }
  196.  
  197. }
  198.  
  199. sub return_html {
  200.  
  201.    if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) {
  202.  
  203.       # If the redirect option of the form contains a valid url,
  204.       # print the redirectional location header.
  205.  
  206.       print "Location: $CONFIG{'redirect'}\n\n";
  207.    }
  208.    else {
  209.  
  210.       print "Content-type: text/html\n\n";
  211.       print "<html>\n <head>\n";
  212.  
  213.       # Print out title of page
  214.       if ($CONFIG{'title'}) {
  215.      print "  <title>$CONFIG{'title'}</title>\n";
  216.       }
  217.       else {
  218.          print "  <title>Thank You</title>\n";
  219.       }
  220.  
  221.       print " </head>\n <body";
  222.  
  223.       # Get Body Tag Attributes
  224.       &body_attributes;
  225.  
  226.       # Close Body Tag
  227.       print ">\n  <center>\n";
  228.  
  229.       if ($CONFIG{'title'}) {
  230.          print "   <h1>$CONFIG{'title'}</h1>\n";
  231.       }
  232.       else {
  233.          print "   <h1>Thank You For Filling Out This Form</h1>\n";
  234.       }
  235.       print "</center>\n";
  236.  
  237.       print "Below is what you submitted to $CONFIG{'recipient'} on ";
  238.       print "$date<p><hr size=7 width=75\%><p>\n";
  239.  
  240.       if ($CONFIG{'sort'} eq 'alphabetic') {
  241.          foreach $key (sort keys %FORM) {
  242.             # Print the name and value pairs in FORM array to html.
  243.             print "<b>$key:</b> $FORM{$key}<p>\n";
  244.          }
  245.       }
  246.       elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
  247.          $sort_order = $CONFIG{'sort'};
  248.          $sort_order =~ s/order://;
  249.          @sorted_fields = split(/,/, $sort_order);
  250.          foreach $sorted_field (@sorted_fields) {
  251.             # Print the name and value pairs in FORM array to html.
  252.             if ($FORM{$sorted_field}) {
  253.                print "<b>$sorted_field:</b> $FORM{$sorted_field}<p>\n";
  254.          }
  255.          }
  256.       }
  257.       else {
  258.          foreach $key (keys %FORM) {
  259.             # Print the name and value pairs in FORM array to html.
  260.             print "<b>$key:</b> $FORM{$key}<p>\n";
  261.          }
  262.       }
  263.  
  264.       print "<p><hr size=7 width=75%><p>\n";
  265.  
  266.       # Check for a Return Link
  267.       if ($CONFIG{'return_link_url'} =~ /http\:\/\/.*\..*/ && $CONFIG{'return_link_title'}) {
  268.          print "<ul>\n";
  269.          print "<li><a href=\"$CONFIG{'return_link_url'}\">$CONFIG{'return_link_title'}</a>\n";
  270.          print "</ul>\n";
  271.       }
  272.       print "<a href=\"http://www.worldwidemart.com/scripts/formmail.shtml\">FormMail</a> Created by Matt Wright and can be found at <a href=\"http://www.worldwidemart.com/scripts/\">Matt's Script Archive</a>.\n";
  273.       print "</body>\n</html>";
  274.    }
  275. }
  276.  
  277. sub send_mail {
  278.    # Open The Mail Program
  279.  
  280.    open(MAIL,"|$mailprog -t");
  281.  
  282.    print MAIL "To: $CONFIG{'recipient'}\n";
  283.    print MAIL "From: $CONFIG{'email'} ($CONFIG{'realname'})\n";
  284.  
  285.    # Check for Message Subject
  286.    if ($CONFIG{'subject'}) {
  287.       print MAIL "Subject: $CONFIG{'subject'}\n\n";
  288.    }
  289.    else {
  290.       print MAIL "Subject: WWW Form Submission\n\n";
  291.    }
  292.  
  293.    print MAIL "Below is the result of your feedback form.  It was ";
  294.    print MAIL "submitted by $CONFIG{'realname'} ($CONFIG{'email'}) on ";
  295.    print MAIL "$date\n";
  296.    print MAIL "---------------------------------------------------------------------------\n\n";
  297.  
  298.    if ($CONFIG{'print_config'}) {
  299.       @print_config = split(/,/,$CONFIG{'print_config'});
  300.       foreach $print_config (@print_config) {
  301.          if ($CONFIG{$print_config}) {
  302.             print MAIL "$print_config: $CONFIG{$print_config}\n\n";
  303.          }
  304.       }
  305.    }
  306.  
  307.    if ($CONFIG{'sort'} eq 'alphabetic') {
  308.       foreach $key (sort keys %FORM) {
  309.          # Print the name and value pairs in FORM array to mail.
  310.          print MAIL "$key: $FORM{$key}\n\n";
  311.       }
  312.    }
  313.    elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
  314.       $CONFIG{'sort'} =~ s/order://;
  315.       @sorted_fields = split(/,/, $CONFIG{'sort'});
  316.       foreach $sorted_field (@sorted_fields) {
  317.          # Print the name and value pairs in FORM array to mail.
  318.          if ($FORM{$sorted_field}) {
  319.             print MAIL "$sorted_field: $FORM{$sorted_field}\n\n";
  320.          }
  321.       }
  322.    }
  323.    else {
  324.       foreach $key (keys %FORM) {
  325.          # Print the name and value pairs in FORM array to html.
  326.             print MAIL "$key: $FORM{$key}\n\n";
  327.       }
  328.    }
  329.  
  330.    print MAIL "---------------------------------------------------------------------------\n";
  331.  
  332.    # Send Any Environment Variables To Recipient.
  333.    foreach $env_report (@env_report) {
  334.       print MAIL "$env_report: $ENV{$env_report}\n";
  335.    }
  336.  
  337.    close (MAIL);
  338. }
  339.  
  340. sub error {
  341.  
  342.    ($error,@error_fields) = @_;
  343.  
  344.    print "Content-type: text/html\n\n";
  345.  
  346.    if ($error eq 'bad_referer') {
  347.       print "<html>\n <head>\n  <title>Bad Referrer - Access Denied</title>\n </head>\n";
  348.       print " <body>\n  <center>\n   <h1>Bad Referrer - Access Denied</h1>\n  </center>\n";
  349.       print "The form that is trying to use this <a href=\"http://www.worldwidemart.com/scripts/\">FormMail Program</a>\n";
  350.       print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.<p>\n";
  351.       print "Sorry!\n";
  352.       print "</body></html>\n";
  353.    }
  354.  
  355.    elsif ($error eq 'request_method') {
  356.       print "<html>\n <head>\n  <title>Error: Request Method</title>\n </head>\n";
  357.       print "</head>\n <body";
  358.  
  359.       # Get Body Tag Attributes
  360.       &body_attributes;
  361.  
  362.       # Close Body Tag
  363.       print ">\n <center>\n\n";
  364.  
  365.       print "   <h1>Error: Request Method</h1>\n  </center>\n\n";
  366.       print "The Request Method of the Form you submitted did not match\n";
  367.       print "either GET or POST.  Please check the form, and make sure the\n";
  368.       print "method= statement is in upper case and matches GET or POST.\n";
  369.       print "<p><hr size=7 width=75%><p>\n";
  370.       print "<ul>\n";
  371.       print "<li><a href=\"$ENV{'HTTP_REFERER'}\">Back to the Submission Form</a>\n";
  372.       print "</ul>\n";
  373.       print "</body></html>\n";
  374.    }
  375.  
  376.    elsif ($error eq 'missing_fields') {
  377.  
  378.       print "<html>\n <head>\n  <title>Error: Blank Fields</title>\n </head>\n";
  379.       print " </head>\n <body";
  380.       
  381.       # Get Body Tag Attributes
  382.       &body_attributes;
  383.          
  384.       # Close Body Tag
  385.       print ">\n  <center>\n";
  386.  
  387.       print "   <h1>Error: Blank Fields</h1>\n\n";
  388.       print "The following fields were left blank in your submission form:<p>\n";
  389.  
  390.       # Print Out Missing Fields in a List.
  391.       print "<ul>\n";
  392.       foreach $missing_field (@error_fields) {
  393.          print "<li>$missing_field\n";
  394.       }
  395.       print "</ul>\n";
  396.  
  397.       # Provide Explanation for Error and Offer Link Back to Form.
  398.       print "<p><hr size=7 width=75\%><p>\n";
  399.       print "These fields must be filled out before you can successfully submit\n";
  400.       print "the form.  Please return to the <a href=\"$ENV{'HTTP_REFERER'}\">Fill Out Form</a> and try again.\n";
  401.       print "</body></html>\n";
  402.    }
  403.    exit;
  404. }
  405.  
  406. sub body_attributes {
  407.    # Check for Background Color
  408.    if ($CONFIG{'bgcolor'}) {
  409.       print " bgcolor=\"$CONFIG{'bgcolor'}\"";
  410.    }
  411.  
  412.    # Check for Background Image
  413.    if ($CONFIG{'background'} =~ /http\:\/\/.*\..*/) {
  414.       print " background=\"$CONFIG{'background'}\"";
  415.    }
  416.  
  417.    # Check for Link Color
  418.    if ($CONFIG{'link_color'}) {
  419.       print " link=\"$CONFIG{'link_color'}\"";
  420.    }
  421.  
  422.    # Check for Visited Link Color
  423.    if ($CONFIG{'vlink_color'}) {   
  424.       print " vlink=\"$CONFIG{'vlink_color'}\"";
  425.    }
  426.  
  427.    # Check for Active Link Color
  428.    if ($CONFIG{'alink_color'}) {
  429.       print " alink=\"$CONFIG{'alink_color'}\"";
  430.    }
  431.  
  432.    # Check for Body Text Color
  433.    if ($CONFIG{'text_color'}) {
  434.       print " text=\"$CONFIG{'text_color'}\"";
  435.    }
  436. }
  437.